home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / dev / lang / sbp3_1e.lzh / TEMPLATE.PL < prev    next >
Text File  |  1991-10-31  |  3KB  |  141 lines
  1. /* From the book PROLOG PROGRAMMING IN DEPTH
  2.    by Michael A. Covington, Donald Nute, and Andre Vellino.
  3.    Copyright 1988 Scott, Foresman & Co.
  4.    Non-commercial distribution of this file is permitted. */
  5. /* Modified for Quintus Prolog by Andreas Siebert */
  6.  
  7. /* TEMPLATE.PL */
  8.  
  9. /* Simple natural language understander using templates. */
  10.  
  11. /* Uses READSTR.PL and TOKENIZE.PL */
  12. :- (clause(readstring(_),_) ; consult('readstr.pl')).
  13. :- (clause(tokenize(_,_),_) ; consult('tokenize.pl')).
  14.  
  15. :- unknown(_,fail),nl,nl. /* unknown procedures just fail without warning */
  16.  
  17. /*
  18.  * process(Wordlist)
  19.  *  translates Wordlist into Prolog and asserts it if it
  20.  *  is a statement or queries it if it is a question.
  21.  */
  22.  
  23. /* Note that this procedure assumes that whenever a word ends in S,
  24.    the S is an affix (either noun plural or verb singular). */
  25.  
  26. process([X,is,a,Y]) :-        /* [fido,is,a,dog] => dog(fido). */
  27.      !,
  28.      Fact =.. [Y,X],
  29.      note(Fact).
  30.  
  31. process([X,is,an,Y]) :-       /* same, with "an" */
  32.      !,
  33.      process([X,is,a,Y]).
  34.  
  35. process([is,X,a,Y]) :-        /* [is,fido,a,dog] => ?-dog(fido). */
  36.      !,
  37.      Query =.. [Y,X],
  38.      check(Query).
  39.  
  40. process([is,X,an,Y]) :-       /* same, but with "an" */
  41.      !,
  42.      process([is,X,a,Y]).
  43.  
  44. process([X,are,Y]) :-         /* [dogs,are,animals] =>           */
  45.      !,                       /*      animal(X) :- dog(X).       */
  46.      remove_s(X,X1),
  47.      remove_s(Y,Y1),
  48.      Head =.. [Y1,Z],
  49.      Tail =.. [X1,Z],
  50.      note((Head :- Tail)).
  51.  
  52. process([does,X,Y]) :-        /* [does,fido,sleep] => ?-sleep(fido). */
  53.      !,
  54.      Query =.. [Y,X],
  55.      check(Query).
  56.  
  57. process([X,Y]) :-             /* [fido,sleeps] => sleep(fido). */
  58.      \+ remove_s(X,_),
  59.      remove_s(Y,Y1),
  60.      !,
  61.      Fact =.. [Y1,X],
  62.      note(Fact).
  63.  
  64. process([X,Y]) :-             /* [dogs,sleep] => sleep(X) :- dog(X). */
  65.      remove_s(X,X1),
  66.      \+ remove_s(Y,_),
  67.      !,
  68.      Head =.. [Y,Z],
  69.      Tail =.. [X1,Z],
  70.      note((Head :- Tail)).
  71.  
  72. process(_) :-
  73.      write('I do not understand.'),
  74.      nl.
  75.  
  76. /*
  77.  * remove_s(X,X1)
  78.  *  removes final S from X giving X1,
  79.  *  or fails if X does not end in S.
  80.  */
  81.  
  82. remove_s(X,X1) :-
  83.      name(X,XList),
  84.      remove_s_list(XList,X1List),
  85.      name(X1,X1List).
  86.  
  87. remove_s_list("s",[]).
  88.  
  89. remove_s_list([Head|Tail],[Head|NewTail]) :-
  90.      remove_s_list(Tail,NewTail).
  91.  
  92. /*
  93.  * check(Query)
  94.  *   Try Query. Report whether it succeeded.
  95.  */
  96.  
  97. check(Query) :- /* write('Trying query: ?- '), */
  98.                 /* write(Query),  */     /* Un-comment these lines */
  99.                 /* nl,            */     /* to see the translations */
  100.                 call(Query),
  101.                 !,
  102.                 write('Yes.'),
  103.                 nl.
  104.  
  105. check(_) :-     write('Not as far as I know.'),
  106.                 nl.
  107.  
  108. /*
  109.  * note(Fact)
  110.  *  Asserts Fact and prints acknowledgement.
  111.  */
  112.  
  113. note(Fact) :-  /* write('Adding to knowledge base: '), */
  114.                /* write(Fact),     */   /* Un-comment these lines */
  115.                /* nl,              */   /* to see the translations */
  116.                asserta(Fact),
  117.                write('OK'),
  118.                nl.
  119.  
  120. /*
  121.  * go
  122.  *  Accept and process one sentence.
  123.  */
  124.  
  125. go :- readstring(S),
  126.       nl,
  127.       tokenize(S,T),
  128.       process(T).
  129.  
  130. /*
  131.  * Starting query
  132.  */
  133.  
  134. start :- write('TEMPLATE.PL at your service.'),nl,
  135.          write('Terminate by pressing Ctrl-C.'),nl,
  136.          repeat,
  137.            go,
  138.          fail.
  139.  
  140. :-start.
  141.